unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ComCtrls, http, inifiles, idGlobal, Rijndael,
  MultiInst, CoolTrayIcon, Menus, fileutils, ExtCtrls;

type
  TForm1 = class(TForm)
    ServerSocket: TServerSocket;
    Memo1: TMemo;
    Button1: TButton;
    StatusBar1: TStatusBar;
    MultiInstance1: TMultiInstance;
    CoolTrayIcon1: TCoolTrayIcon;
    PopupMenu1: TPopupMenu;
    RestartService1: TMenuItem;
    N1: TMenuItem;
    erminate1: TMenuItem;
    Timer1: TTimer;
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure RestartService1Click(Sender: TObject);
    procedure erminate1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    inifile: TMemIniFile;
  public
    procedure get_matching(domain: string; var matching: tstringlist);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  crypt_rijndael: TDCP_Rijndael;

const
  aPASSPHRASE = 'my spoon is too big';
  aFILENAME = 'secure.ini';
  aTMPFILENAME = 'tmp.ini';

function decodestring(key, s: string): string;
var i: integer;
begin
  crypt_rijndael.InitStr(key);

  crypt_rijndael.DecryptCFB(s[1], s[1], length(s));

  crypt_rijndael.Reset();
  crypt_rijndael.Burn();

  result := s;
end;

function encodestring(key, s: string): string;
var i: integer;
begin
  crypt_rijndael.InitStr(key);

  crypt_rijndael.EncryptCFB(s[1], s[1], length(s));

  crypt_rijndael.Reset();
  crypt_rijndael.Burn();

  result := s;
end;

function LocalPath: string;
begin
  Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)));
end;

procedure TForm1.get_matching(domain: string; var matching: tstringlist);
var
  sections: tstringlist;
  url: string;
  i, j, k: integer;
begin
  sections := TStringList.create;
  inifile.ReadSections(sections);

  for i := 0 to sections.Count - 1 do
  begin
    url := LowerCase(inifile.ReadString(sections[i], 'url', ''));
    memo1.lines.add(LowerCase(domain) + '=' + url);
    if (pos(LowerCase(domain), url) > 0) then
      matching.add(sections[i]);
  end;
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  s, Request: string;
  matching, fparams, fdata: Tstringlist;
  html, cmd, domain, passcard: string;
  newLogin, data: string;
  i, j, k: integer;
begin
  Request := Socket.ReceiveText;
  fparams := Tstringlist.Create;
  matching := TStringList.Create;

  html := FloatToStr(random);

  QueryString(extract_query(Request), fparams);
  memo1.Lines.add(extract_query(Request));
  cmd := fparams.Values['type'];

  if (cmd = 'load') then
  begin
    domain := GetDomainRoot(fparams.Values['url']);
    memo1.lines.add(domain);
    get_matching(domain, matching);
    html := matching.Text;
    memo1.lines.AddStrings(matching);
  end
  else if (cmd = 'passcard') then
  begin
    passcard := fparams.Values['passcard'];
    inifile.ReadSectionValues(passcard, matching);
    html := matching.Text;
    memo1.text := html;
  end else if (cmd = 'save') then
  begin
    passcard := fparams.Values['passcard'];
    fdata := Tstringlist.Create;
    try
      QueryString(URLDecode(fparams.Values['data']), fdata);

      inifile.EraseSection(passcard);
      inifile.writestring(passcard, 'url', fparams.Values['url']);

      for i := 0 to fdata.Count - 1 do
        inifile.WriteString(passcard, fdata.names[i], fdata.values[fdata.names[i]]);

      inifile.Rename(aTMPFILENAME, false);
      inifile.UpdateFile;

      writefile(LocalPath + aFILENAME, encodestring(aPASSPHRASE, readfile(LocalPath + aTMPFILENAME)));
      deletefile(LocalPath + aTMPFILENAME);
    finally
      fdata.free;
    end;
  end;

  Socket.SendText(http_header + wrap_html(html));

  repeat
    s := Socket.ReceiveText;
  until s = '';

  Sleep(1000);
  statusbar1.SimpleText := 'done';
  Socket.Close;

  matching.free;
  fparams.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  newLogin: string;
begin
  if ServerSocket.Active then begin
    ServerSocket.Close;
    StatusBar1.SimpleText := 'Stopped.';
    Button1.Caption := 'Start';
  end else begin
    ServerSocket.Open;
    StatusBar1.SimpleText := 'Active.';
    Button1.Caption := 'Stop';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  inipath, tmppath: string;
begin
  top := -10000;
  inipath := LocalPath + aFILENAME;
  tmppath := LocalPath + aTMPFILENAME;

  if (not fileexists(inipath)) then
    writefile(inipath, encodestring(aPASSPHRASE, '[welcome]'));

  writefile(tmppath, decodestring(aPASSPHRASE, readfile(inipath)));
  inifile := TMemIniFile.Create(tmppath);
  deletefile(tmppath);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  inifile.Free;
end;

procedure TForm1.RestartService1Click(Sender: TObject);
begin
  Button1Click(Sender);
end;

procedure TForm1.erminate1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  hide;
  timer1.enabled := false;
end;

var
  nWindowStyle: LongInt;

begin
  ShowWindow(Application.Handle, SW_HIDE);
  SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
  ShowWindow(Application.Handle, SW_SHOW);
  crypt_rijndael := TDCP_Rijndael.Create(nil);
end.

